
{*******************************************************}
{                                                       }
{       Turbo Pascal for Windows                        }
{       Standard windows unit for ObjectWindows         }
{       Modified for CARTO-PC - JMM - 13/07/92          }
{                                                       }
{       Copyright (c) 1991 Borland International        }
{                                                       }
{*******************************************************}

unit FacWnds;

interface

uses
     SysUtils, Messages,
     Objects, WinTypes, WinProcs, WinCrt, WinDos,
     OStdDlgs, Strings, OWindows, ODialogs,
     CARTOCmds, ChildWnds, CartoDlg,
     tit_win,get_win,gmuf_win,aux_win,outl_win,coul_win,
     KobjWnds, wfac;

type

  { TFacWindow }
                    
  PFacWindow = ^TFacWindow;
  TFacWindow = object(TKFileWindow)
    nuknumb : integer;
    nuki : Num_Lay;
    constructor Init(AParent: PWindowsObject;
    			 KFileName: String; gmk_loc:PHeader; KObjType: Integer);
    Destructor Done; virtual;
    procedure SetUpWindow; virtual;
    procedure Adjustsize;
    procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;

    procedure GetWindowClass(var AWndClass: TWndClass); virtual;
    function  GetClassName: PChar; virtual;
    procedure   Image_Activate(VAR Msg : TMessage);
      Virtual   cm_First + cmCM_IMAGEACTIV;

    procedure Run_CombFac(var Msg: TMessage);
      virtual cm_First + cmCM_CORRAPPLY;

  end;

implementation

{ TKFileWindow }

{ Constructor for a TKFileWindow.  Initializes its data fields using
  passed parameters and default values. }
constructor TFacWindow.Init(AParent: PWindowsObject;
                KFileName: String; gmk_loc:PHeader; KObjType: Integer);

var
  i : integer;
  DC : HDC;
  OldFont : Hfont;
  TM: TTextMetric;

  label 999;

begin

  TMyMDIChild.Init(AParent, KObjType, KFileName);
  if Status < 0 then begin Status := em_InvalidWindow; goto 999; end;

  (* Calcul de la taille de la fenetre et verif objet *)
  Attr.W := 600;  Attr.H := 220;
  Attr.Style := Attr.Style or ws_VScroll ;
  Scroller := New(PScroller, Init(@Self, 1, 1, 600, 600));

  for i := 1 to 40 do gmklay^.prm[i] := gmk_loc^.prm[i];
  TheFont := 0; TheFont := CreateFontIndirect(KLogFont);

  nuknumb := gmklay^.prm[29];

999:end;

destructor TFacWindow.Done;
begin
    if TheFont <> 0 then DeleteObject(TheFont);
    TMyMDIChild.Done;
end;

procedure TFacWindow.SetUpWindow;
var
  hwndClient, hwndFrame : hWND;
  Line: PString;
  i : integer;
label 999;
begin
  hwndClient := GetParent(hWindow);
  hwndFrame := GetParent(hwndClient);
  TMyMDIChild.SetUpWindow;

  if Status <0 then begin
    Status := em_InvalidWindow;
    Obj_Kill := copy(ObjTitle,1,length(ObjTitle));
    PostMessage(hwndFrame, wmOBJ_KILL, 0 ,0);
    goto 999;
  end;

  for i := 0 to nuknumb-1 do begin
    Line := KLines^.At(i);
    _nextpar(strw,Line^); val(strw, nuki[i+1], erreur);
    if erreur <> 0 then begin
      Status := em_InvalidWindow;
      Obj_Kill := copy(ObjTitle,1,length(ObjTitle));
      PostMessage(hwndFrame, wmOBJ_KILL, 0 ,0);
      goto 999;
    end;
  end;

  AdjustSize;
999:end;

procedure TFacWindow.Adjustsize;
var
    DC: HDC;
    xstart,ystart,height,width:integer;
    dwExtent : Longint;
    TR : Trect;
    OldFont: hFont;
begin

  DC     := GetDC(hWindow);
  OldFont := SelectObject(DC, TheFont);

  xstart := 10; ystart := 10;
  StrPcopy(MessageText,'T');
  dwExtent := GetTextExtent(DC, MessageText, StrLen(MessageText));
  height := ystart + HIWORD(dwExtent)*(KLines^.Count+1-nuknumb) + 10;
  width  := xstart + LOWORD(dwExtent)*MaxLineL + 40;  { 40 = scroller }
  SelectObject(DC, Oldfont);
  ReleaseDC(hWindow, DC);

  if width < 50 then width := 50;
  if height < 50 then height := 50;
  Scroller^.SetRange(width , height);
  Scroller^.ScrollTo(0, 0);

  if width > 600 then width := 600;
  if height > 220 then height := 220;
  SetWindowPos(hWindow, 0, 0, 0,
      width, height,
      swp_NoZOrder OR swp_NoMove);

end;
procedure TFacWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
var
  Line: PString;
  xstart,ystart:integer;
  dwExtent : Longint;
  i:integer;
  OldFont: HFont;
label 999;
begin
  if Status = em_InvalidWindow then goto 999;
  OldFont := SelectObject(PaintDC, TheFont);

  xstart := 10; ystart := 10;
  for i := nuknumb to KLines^.Count-1 do begin
    Line := KLines^.At(i);

    if Length(Line^) = 0 then StrPCopy(MessageText, ' ')
      else StrPcopy(MessageText, Line^);

    TextOut(PaintDC, xstart, ystart, MessageText, StrLen(MessageText));
    dwExtent := GetTextExtent(PaintDC, MessageText, StrLen(MessageText));
    ystart := ystart + HIWORD(dwExtent);
  end;

  SelectObject(PaintDC, Oldfont);

999:end;

procedure TFacWindow.GetWindowClass(var AWndClass: TWndClass);
begin
  TMyMDIChild.GetWindowClass(AWndClass);
  AWndClass.hIcon := LoadIcon(HInstance, 'ICON_TABLE');
end;

function TFacWindow.GetClassName: PChar;
begin
  GetClassName := 'FacWidow';
end;

procedure TFacWindow.Image_Activate(VAR Msg : TMessage);
label 999;
begin
  Loadstring(HInstance, stW_Tit_FAC1+Lang, @MessageText, 79);
  if not(Is_AnObject(ObjTitle,StrPas(MessageText),Obj_Activate,1)) then goto 999;
  DefCommandProc(Msg);
999:end;

procedure TFacWindow.Run_CombFac(var Msg: TMessage);
var
  hwndClient, hwndFrame : hWND;

  DataCombFac:TCombFacData;
  CombFacDlg:PCombFacDlg;

  FacLay,k,nukFac : integer;
  nomKan: st10;
  gmk_cla : pheader;
  hist_res : phisto;
  lut_res : pitable;
  ldb,lfn,lps,kdb,kfn,kps:integer;
  bor1,bor2 : integer;
  type_out : integer;

label 999;

begin

  hwndClient := GetParent(hWindow);
  hwndFrame := GetParent(hwndClient);
  { Get Title of called object }

  hist_res := nil; lut_res := nil; gmk_cla := nil;
  ier := _getmem('-',Pointer(hist_res),sizeOf(histo));
  if ier <> 0 then goto 999;
  ier := _getmem('-',Pointer(lut_res),sizeOf(itable));
  if ier <> 0 then goto 999;
  ier := _getmem('-',Pointer(gmk_cla),sizeOf(header));
  if ier <> 0 then goto 999;

  Loadstring(HInstance, stW_Tit_FAC1+Lang, @MessageText, 79);
  if not(Is_AnObject(ObjTitle,StrPas(MessageText),Nom_obj,0)) then goto 999;
  Loadstring(HInstance, stW_Tit_Image+Lang, @MessageText, 79);
  AHTitle := StrPas(MessageText)+Nom_Obj;
  nom_image := nam64(copy(Nom_Obj,1,length(Nom_Obj)));

  ier := hopen(nom_image,gmf,gmh);
  if ier <> 0 then begin
    LoadString(HInstance, stWCPC_Readerr+Lang, @MessageText, 79);
    LoadString(HInstance, stW_ObjCrea+Lang, @TitleText, 79);
    MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
    goto 999;
  end;
  ier := clef_open(gmf,gmh);
  if (ier <> 0) or (ISTAPROT <> 0 ) then begin
    if FacLay <> 0 then begin
      if ISTAPROT <> FacLay then begin
        Loadstring(HInstance, stW_CanAttTut+Lang, @MessageText, 79);
        Loadstring(HInstance, stW_DemoTit+Lang, @TitleText, 79);
        MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
        ier := hclose(gmf);
        goto 999;
      end;
    end else begin
      Loadstring(HInstance, stW_CanAttTut+Lang, @MessageText, 79);
      Loadstring(HInstance, stW_DemoTit+Lang, @TitleText, 79);
      MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
      ier := hclose(gmf);
      goto 999;
    end;
  end;

    if val_proc = -1 then begin
      if (gmf^.nbcol > MAXDISP) then begin
        Loadstring(HInstance, stW_DemoSize+Lang, @MessageText, 79);
        Loadstring(HInstance, stW_DemoTit+Lang, @TitleText, 79);
        MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
        ier := hclose(gmf);
        goto 999;
      end;
    end;

  with DataCombFac do begin
    StrPCopy(ImageName,Nom_Obj);
    nukFac := 1;
    Numbfac := nukFac;
  end;
  ier := hclose(gmf);

  CombFacDlg := New(PCombFacDlg, Init(@Self,hWCPC_COMBFAC,
                           'WCPC_COMBFAC', @DataCombFac));

  if (Application^.ExecDialog(CombFacDlg) <> id_OK ) then goto 999;

  type_out := Out_Style;

  with DataComBFac do begin
    nukFac := NumbFac;
    if (abs(nukfac) < 1) or (abs(nukfac) > nuknumb) then begin
        LoadString(HInstance, stW_AnaRg+Lang, @MessageText, 79);
        LoadString(HInstance, stW_AnaComp+Lang, @TitleText, 79);
        MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
        ier := hclose(gmf);
        goto 999;
    end;
  end;

  Faclay := OUTLay1_Selected + 1;
  if Faclay <= gmf^.nbkan then begin
    ier := hopen(nom_image,gmf,gmh);
    if ier <> 0 then goto 999;
    ier := kopen(Faclay,gmf,gmk);
    if ier <> 0 then begin ier := hclose(gmf); goto 999; end;
    if (gmk^.prm[38] <> 0) or (gmk^.prm[39] <> 0) then begin
      LoadString(HInstance, stW_LayWNoSub+Lang, @MessageText, 79);
      Loadstring(HInstance, stW_LayWrite+Lang, @TitleText, 79);
      MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
      ier := hclose(gmf); goto 999;
    end;
    ier := hclose(gmf);
  end;
  if Faclay > gmf^.nbkan then Faclay := 0;

  ier := hopen(nom_image,gmf,gmh);
  if ier <> 0 then begin
    LoadString(HInstance, stWCPC_Readerr+Lang, @MessageText, 79);
    LoadString(HInstance, stW_ObjCrea+Lang, @TitleText, 79);
    MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
    goto 999;
  end;

  if Faclay = 0 then begin

  if tutor_mode then begin
    ier := clef_write(gmf^.nbkan+1,gmf,gmh);
    if ier <> p_Fac then begin
      DiagTut := New(PTeraTutDiag, Init(@Self,'WCPC_TUTW'));
      DiagTut^.Execute;
      ier := hclose(gmf);
      goto 999;
    end;
  end;

    nomkan := copy(OUTFile,1,8);
    gmk_cla^.txt := copy(OUTTitle,1,39);
    FacLay := 0;
    gmk_cla^.txt := txtnam(gmk_cla^.txt,nomkan);
    ier := kcreate(FacLay,gmf,gmk_cla);
    if ier <> 0 then begin
      LoadString(HInstance, stW_LayoutErrC+Lang, @MessageText, 79);
      LoadString(HInstance, stW_LayCLADo+Lang, @TitleText, 79);
      MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
      ier :=hclose(gmf);
      goto 999;
    end;

  end else begin    { Faclay <> 0 }

    if tutor_mode then begin
      ier := clef_write(Faclay,gmf,gmh);
      if ier <> p_Fac then begin
        DiagTut := New(PTeraTutDiag, Init(@Self,'WCPC_TUTW'));
        DiagTut^.Execute;
        ier := hclose(gmf);
        goto 999;
      end;
    end;
      ier := kopen(Faclay,gmf,gmk_cla);
      if ier <> 0 then begin
        LoadString(HInstance, stW_LayoutErrO+Lang, @MessageText, 79);
        LoadString(HInstance, stW_AnaComp+Lang, @TitleText, 79);
        MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
        ier := hclose(gmf);
        goto 999;
      end;

      for k := 4 to 40 do gmk_cla^.prm[k] := 0;  { Effacement de tous les aux. }
      gmk_cla^.txt := txt47(OUTTitle);
      ier := kmodif(Faclay,gmf,gmk_cla);

   end;

   Faclay := abs(Faclay);
   ier := hclose(gmf);

   UpdateWindow(hwndClient);
   SendMessage(hwndFrame,wmRUN_CREATE, 0 ,0);
   ier := w_fac(nom_image,nuknumb,nuki,nukFac,FacLay,type_out,S);
   SendMessage(hwndFrame,wmRUN_DONE, 0 ,0);

   if ier <> 0 then begin
     LoadString(HInstance, stW_AnaComp+Lang, @TitleText, 79);
     StrPcopy(MessageText, S);
     goto 999;
   end;

   ier := hopen(nom_image,gmf,gmh);
   if ier <> 0 then goto 999;
   ier := kopen(Faclay,gmf,gmk_cla);
   if ier <> 0 then begin ier := hclose(gmf); goto 999; end;
   UpdateWindow(HwndClient);


   gmk^.prm[21] := type_out;
   if type_out in [10..14] then gmk^.prm[26] := abs(LAY_DEPTH[type_out]);
   ier := kmodif(FacLay,gmf,gmk);

   if Type_out = 1 then begin

     SendMessage(hwndFrame,wmRUN_CREATE, 0 ,0);
     if gmf^.nblig < MAXDISP then chisto(FacLay,gmf,hist_res^)
      else begin
       ier := rwindow(ldb,lfn,lps,kdb,kfn,kps,gmf);
       histwin(hist_res^,gmf,FacLay,ldb,lfn,lps,kdb,kfn,kps);
     end;
     SendMessage(hwndFrame,wmRUN_DONE, 0 ,0);
     UpdateWindow(HwndClient);
     ier := whisto(FacLay,gmf,hist_res^);

     bor1 := 0; bor2 := 255;
     col_opt(hist_res^,lut_res^);
     ier := wilut(FacLay,1,gmf,lut_res^); (* Linear *)

   end;

   ier := hclose(gmf);

(* Controle post-process*)
  ier := hopen(nom_image,gmf,gmh);
  if ier <> 0 then begin
    LoadString(HInstance, stWCPC_Readerr+Lang, @MessageText, 79);
    LoadString(HInstance, stW_ObjCrea+Lang, @TitleText, 79);
    MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
    goto 999;
  end;
    ier := clef_open(gmf,gmh);
    if ier <> 0 then goto 999;
    if ISTAPROT = abs(Faclay) then begin
      clef_erase(Faclay,gmf,gmk_cla);
      Loadstring(HInstance, stW_CanOutTut+Lang, @MessageText, 79);
      Loadstring(HInstance, stW_DemoTit+Lang, @TitleText, 79);
      MessageBox(HWindow, MessageText, TitleText, mb_IconStop);
    end;
  ier := hclose(gmf);

  Obj_Kill := AHTitle;
  SendMessage(hwndFrame, wmOBJ_KILL, 0 ,0);
  Obj_Activate := Nom_obj;
  SendMessage(hwndFrame, wmCM_IMAGESELECT, 0 ,0);
  Layer_Selected := abs(Faclay);
  SendMessage(hwndFrame, WM_COMMAND, cmCM_SELECT1 ,0);

999:
  _freemem('-',pointer(hist_res),sizeOf(histo));
  _freemem('-',pointer(lut_res),sizeOf(itable));
  _freemem('-',pointer(gmk_cla),sizeOf(header));
end;

end.
